home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rfix0424.arc / R-PC0424.MRG < prev    next >
Encoding:
Text File  |  1988-04-24  |  15.7 KB  |  395 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against rbbs-pc.bas to produce r-pc0424.bas
  3. * rbbs-pc.bas:  Date 3-25-1988  Size 216139 bytes
  4. * ------------[ Created 04-24-1988 09:52:02 ]------------
  5. * REPLACING old line(s) by new
  6. * ------[ first line different ]------
  7. 105 VERSION.ID$ = "CPC16.1A with fixes through 04-24-88"             ' TF042401
  8.     XOFF$ = CHR$(19)
  9.     XON$ = CHR$(17)
  10.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  11.   ' ******************** Logon Error Message Table ****************************
  12. * REPLACING old line(s) by new
  13. 150 IF SUB.BOARD THEN _
  14.        GOSUB 12987 : _
  15.        GOSUB 5135 : _
  16.        GOTO 165
  17.     SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
  18.     SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
  19.     SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
  20.     PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
  21.     IF TURN.PRINTER.OFF THEN _
  22.        PRINTER = FALSE
  23.     EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2))
  24.     EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  25.     BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  26.     SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
  27.     MID$(MESSAGE.RECORD$,57,1) = "I"
  28.     PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2))
  29.     MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
  30. * ------[ first line different ]------
  31.     LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))                    ' TF033101
  32.     IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _
  33.        TURBO.LOGON = TRUE
  34.     PUT 1,NODE.RECORD.INDEX
  35.     GOSUB 12985
  36. '
  37. ' *****************************************************************************
  38. ' *  TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER                       *
  39. ' *****************************************************************************
  40. '
  41. * REPLACING old line(s) by new
  42. 175 GOSUB 5344
  43.     IF DIR.CATEGORY.FILE$ <> PREV.DIRCAT$ THEN _
  44.        PREV.DIRCAT$ = DIR.CATEGORY.FILE$ : _
  45.        CALL CTLINES (MAX.ENTRIES) : _
  46.        REDIM CATEGORY.NAME$(MAX.ENTRIES),CATEGORY.CODE$(MAX.ENTRIES),_
  47.              CATEGORY.DESC$(MAX.ENTRIES) : _
  48.        CALL INITFMS (CATEGORY.NAME$(),CATEGORY.CODE$(), _
  49.                      CATEGORY.DESC$(),NUM.CATEGORIES)
  50.     LOCAL.USER.MODE = (RIGHT$(COM.PORT$,1) < "1")
  51.     REMOTE.ECHO = (DEFAULT.ECHOER$ = "R" AND NOT LOCAL.USER.MODE)
  52.     CALL BRKFNAME (CALLERS.FILE$,DRV$,X$,Y$,TRUE)
  53.     NODE.WORK.FILE$ = DRV$ + _
  54.                       "NODE" + _
  55.                       NODE.ID$ + _
  56.                       "WRK.BAT"
  57.     SECONDS.PER.SESSION! = MINUTES.PER.SESSION! * 60
  58.     IF NOT LOCAL.USER.MODE THEN _
  59. * ------[ first line different ]------
  60.        IF NOT EXIT.TO.DOORS THEN _                                   ' TF033101
  61.           GOTO 180 _                                                 ' TF033101
  62.        ELSE IF NOT LOCAL.USER THEN _                                 ' TF033101
  63.                GOTO 180                                              ' TF033101
  64.     LOCAL.USER = TRUE
  65.     BPS = -7
  66.     BAUD.TEST = 19200
  67.     EIGHT.BIT = TRUE
  68.     SNOOP = TRUE
  69.     RECYCLE.TO.DOS = TRUE
  70.     IF EXIT.TO.DOORS THEN _
  71.        CALL AMORPM : _
  72.        CALL READPROF : _
  73.        GOTO 410
  74.     GOSUB 178
  75.     GOTO 345
  76. * REPLACING old line(s) by new
  77. 821 CALL TRIM (CI$)
  78.     IF PRIVATE.DOOR AND _
  79.        TRANSFER.FUNCTION = 3 THEN _
  80.        TRANSFER.FUNCTION = 0 : _
  81.        GOTO 832
  82.     IF REGISTRATION.PROGRAM$ = "NONE" OR _
  83.        REGISTRATION.PROGRAM$ = "" THEN _
  84.        GOTO 832
  85. * ------[ first line different ]------
  86.     B$ = REGISTRATION.PROGRAM$                                       ' TF033105
  87.     TRANSFER.FUNCTION = 3                                            ' TF033105
  88.     CALL XFRETURN
  89. '
  90. ' *****************************************************************************
  91. ' *  ESC PRESSED ON LOCAL CONSOLE ENTERS HERE                                 *
  92. ' *****************************************************************************
  93. '
  94. * REPLACING old line(s) by new
  95. 822 LOCATE 24,1
  96.     CALL FINDTIME (USER.LOGON.TIME!)
  97.     CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  98.     LOCAL.USER = TRUE
  99. * ------[ first line different ]------
  100.     SNOOP = TRUE                                                     ' TF033103
  101.     WAIT.BEFORE.DISCONNECT = 32400
  102.     BPS = -7
  103.     CALL MUZAK (2)
  104.     IF LOCAL.PASSWORD$ = "NONE" THEN _
  105.        GOTO 828
  106.     D$ = "Enter PASSWORD (dots echo) "
  107.     GOSUB 1310
  108.     Z$ = ""
  109.     INKEYS.PRESSED = 0
  110. * REPLACING old line(s) by new
  111. 836 IF LOCAL.USER THEN _
  112. * ------[ first line different ]------
  113.        TALK.TO.MODEM.AT$ = "19200" : _                               ' TF033101
  114.        BAUD.PARITY$ = "19200 BAUD,N,8,1" : _                         ' TF033101
  115.        SNOOP = TRUE : _
  116.        LINE.FEEDS = TRUE : _
  117.        A = INSTR(TRANSFER.OPTIONS$,CARRIAGE.RETURN$) : _
  118.        IF A > 0 THEN _
  119.           MID$(TRANSFER.OPTIONS$,A,1) = " "
  120. * REPLACING old line(s) by new
  121. 1235 Z$ = B$(1)
  122.      IF LEN(Z$) < 1 THEN _
  123.         GOTO 1230
  124.      CALL ALLCAPS (Z$)
  125.      CALL SRCHCMND (SUB.SECTION,FF)
  126.      IF FF < 1 THEN _
  127. * ------[ first line different ]------
  128.         CALL QTPUT ("Unknown command <"+Z$+">",1) : _                ' TF041701
  129.         GOTO 1230
  130. * REPLACING old line(s) by new
  131. 1300 CALL QTPUT ("Message base " + GRN$,1)
  132.      RETURN
  133. * ------[ first line different ]------
  134. ' ***************************************************************************** ' TF041701
  135. ' * COMMON LOCAL DISPLAY PRINT                                                * ' TF041701
  136. ' ***************************************************************************** ' TF041701
  137. * DELETING old line(s)
  138. 1305
  139. * REPLACING old line(s) by new
  140. 2020 IF REPLY THEN _
  141. * ------[ first line different ]------
  142.         FOUND = TRUE : _                                             ' TF041803
  143.         GOTO 2060
  144.      SUBJECT$ = ""
  145.      A$ = "To (Press [ENTER] for All)"
  146.      CALL SKIPLINE (1)
  147.      GOSUB 12995
  148.      IF LEN(B$) > 30 THEN _
  149.         A$ = "30 Char. Max" : _
  150.         GOSUB 12979 : _
  151.         GOTO 2020
  152. * REPLACING old line(s) by new
  153. 2620 A$ = "Line #" + _
  154.           STR$(L) + _
  155.           " is:" + _
  156.           RETURN.LINE.FEED$ + _
  157.           A$(L)
  158.      GOSUB 12977
  159.      IF NOT EXPERT.USER THEN _
  160.         CALL QTPUT ("Search & replace",1)
  161.      A$ = "Search for" + _
  162.           PRESS.ENTER.EXPERT$
  163. * ------[ first line different ]------
  164.      PARSE.OFF = TRUE                                                ' TF041802
  165.      GOSUB 12995
  166.      IF Q = 0 THEN _
  167.         GOTO 2300
  168.      X = INSTR(B$,";")                                               ' TF041802
  169.      IF X > 0 THEN _                                                 ' TF041802
  170.         X$ = LEFT$(B$,X-1) : _                                       ' TF041802
  171.         Y$ = RIGHT$(B$,LEN(B$)-X) : _                                ' TF041802
  172.         GOTO 2660                                                    ' TF041802
  173.      X$ = B$
  174.      A$ = "And replace by"
  175.      PARSE.OFF = TRUE                                                ' TF041802
  176.      GOSUB 12995
  177.      Y$ = B$
  178. * REPLACING old line(s) by new
  179. * ------[ first line different ]------
  180. 4371 IF MESSAGES.SELECTED.INDEX <= NUMBER.MESSAGES.SELECTED THEN _   ' TF041603
  181.         CALL CHECKINT (B$(MESSAGES.SELECTED.INDEX)) : _              ' TF041603
  182.         IF EC <> 0 THEN _                                            ' TF041603
  183.            EL = 4371 : _                                             ' TF041603
  184.            GOTO 13000 _                                              ' TF041603
  185.         ELSE CURRENT.MESSAGE = TESTED.INTEGER.VALUE : _              ' TF041603
  186.              GOTO 4415                                               ' TF041603
  187. * REPLACING old line(s) by new
  188. 4561   FF = INSTR(MID$(MESSAGE.RECORD$,X),LEFT$(ACTIVE.USER.NAME$,22))
  189.        IF FF > 0 THEN _
  190.           X = LEN(ACTIVE.USER.NAME$) + FF : _
  191.           IF (FF < 7 OR MID$(MESSAGE.RECORD$,FF - 1,1) = " ") AND (X > 58 OR MID$(MESSAGE.RECORD$,X,1) = " ") THEN _
  192.              UH = TRUE _
  193.           ELSE IF FF < 37 THEN _
  194.                   X = 37 : _
  195.                   GOTO 4561
  196. * ------[ first line different ]------
  197.        MSG.TO.CALLER = (UH AND (FF = 37)) OR _                       ' TF041203
  198.                        (MID$(MESSAGE.RECORD$,37,5) = "ALL  ")        ' TF041203
  199.        MSG.FROM.CALLER = UH AND (FF = 6)                             ' TF041203
  200. * REPLACING old line(s) by new
  201. 8050 MESSAGE.FROM$ = MID$(MESSAGE.RECORD$,6,31)
  202.      CALL TRIM (MESSAGE.FROM$)
  203.      IF LEN(MESSAGE.FROM$) < 23 THEN _
  204.         MESSAGE.FROM$ = MESSAGE.FROM$ + _
  205.                         SPACE$(23 - LEN(MESSAGE.FROM$))
  206.      A$ = "Msg # " + _
  207.           LEFT$(MESSAGE.RECORD$,5) + _
  208.           " Dated " + _
  209.           MID$(MESSAGE.RECORD$,68,8) + _
  210.           " " + _
  211.           MID$(MESSAGE.RECORD$,59,8)
  212.      IF USER.SECURITY.LEVEL >= SEC.CHANGE.MSG THEN _
  213.         A$ = A$ + _
  214.              "  Security:" + _
  215.              STR$(MESSAGE.SECURITY)
  216.      IF NOT RET THEN _
  217.         IF READ.MESSAGES THEN _
  218.            CALL QTPUT (A$,1): _
  219.            CALL QTPUT (" From: " + MESSAGE.FROM$,1) : _
  220.            CALL QTPUT ("   To: " + MESSAGE.TO$,1) : _
  221.            A$ = "   Re: " + _
  222.                 SUBJECT$ _
  223.         ELSE A$ = LEFT$(MESSAGE.RECORD$,5) + _
  224.                   " " + _
  225.                   MID$(MESSAGE.RECORD$,68,8) + _
  226.                   " " + _
  227.                   LEFT$(MESSAGE.TO$,19) + _
  228.                   " " + _
  229.                   LEFT$(MESSAGE.FROM$,18) + _
  230.                   " " + _
  231.                   LEFT$(SUBJECT$,24) : _
  232.              GOTO 8080
  233.      IF QUICK.SCAN.MESSAGES OR _
  234. * ------[ first line different ]------
  235.         SCAN.MESSAGES THEN _                                         ' TF041203
  236.            GOTO 8080                                                 ' TF041203
  237.      IF ((NOT SYSOP) AND NOT (MSG.FROM.CALLER)) THEN _               ' TF041203
  238.         GOTO 8077
  239. * REPLACING old line(s) by new
  240. 8076 IF MID$(MESSAGE.RECORD$,123,6) = STRING$(6,0) OR _
  241.         MID$(MESSAGE.RECORD$,123,6) = SPACE$(6) THEN _
  242. * ------[ first line different ]------
  243.            A$ = A$ + " -Not Received-" : _                           ' TF041203
  244.            GOTO 8077                                                 ' TF041203
  245.      YY$ = RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,126,1))),2) + _
  246.            ":" + _
  247.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,127,1))),2) + _
  248.            ":" + _
  249.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,128,1))),2)
  250.      FOR I = 1 TO 8
  251.         IF MID$(YY$,I,1) = " " THEN _
  252.            MID$(YY$,I,1) = "0"
  253.      NEXT
  254.      YY$ = YY$ + _
  255.            " on "
  256.      YY$ = YY$ + _
  257.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,123,1))),2) + _
  258.            "/" + _
  259.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,124,1))),2) + _
  260.            "/" + _
  261.            RIGHT$(STR$(ASC(MID$(MESSAGE.RECORD$,125,1))),2)
  262.      FOR I = 13 TO 20
  263.         IF MID$(YY$,I,1) = " " THEN _
  264.            MID$(YY$,I,1) = "0"
  265.      NEXT
  266.      A$ = A$ + _
  267.           " Received " + _                                           ' TF041203
  268.           YY$
  269. * REPLACING old line(s) by new
  270. * ------[ first line different ]------
  271. 8077 IF MSG.FROM.CALLER OR (NOT MSG.TO.CALLER) THEN _                ' TF041203
  272.         GOTO 8080                                                    ' TF041203
  273.      YY$ = DATE$
  274.      WK$ = TIME$
  275.      MID$(MESSAGE.RECORD$,123,6) = CHR$(VAL(MID$(YY$,1,2))) + _
  276.                                    CHR$(VAL(MID$(YY$,4,2))) + _
  277.                                    CHR$(VAL(MID$(YY$,9,2))) + _
  278.                                    CHR$(VAL(MID$(WK$,1,2))) + _
  279.                                    CHR$(VAL(MID$(WK$,4,2))) + _
  280.                                    CHR$(VAL(MID$(WK$,7,2)))
  281.      GOSUB 12986
  282.      PUT 1,M(MESSAGE.DIM.INDEX,1)
  283.      GOSUB 12987
  284. * REPLACING old line(s) by new
  285. 11520 QUESTIONNAIRE.ABORTED = FALSE
  286.       CALL FINDIT (FILE.NAME$)
  287.       IF NOT OK THEN _
  288.          RETURN
  289.       REDIM A$(256)
  290.       CALL ASKUSERS
  291.       IF ADJUSTED.SECURITY THEN _
  292.          GOSUB 12989 : _
  293.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL) : _
  294.          GOSUB 9440 : _
  295.          GOSUB 12991 : _
  296.          CALL CALLOPT : _
  297.          GOSUB 5135
  298.       REDIM A$(ADIM)
  299.       IF SUBROUTINE.PARAMETER = -1 THEN _
  300. * ------[ first line different ]------
  301.          RETURN 10595                                                ' TF041702
  302.       RETURN
  303. '
  304. ' *****************************************************************************
  305. ' *  A - COMMAND FROM 5- USER MAINTENANCE OPTIONS (ADD USER)                  *
  306. ' *****************************************************************************
  307. '
  308. * REPLACING old line(s) by new
  309. * ------[ first line different ]------
  310. 13000 IF DEBUG THEN _                                                ' TF033102
  311.          A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _
  312.               STR$(EL) + _
  313.               " ERR=" + _
  314.               STR$(EC) : _
  315.               CALL PRINTIT(A$) : _
  316.               D$ = A$ : _
  317.               GOSUB 1315
  318.       IF EL = 1905 AND EC = 63 THEN _
  319.          CLOSE 1 : _
  320.          KILL ACTIVE.MESSAGE.FILE$ : _
  321.          GOTO 5350
  322.       IF EL = 4371 AND EC = 6 THEN _
  323.          GOTO 1200
  324.       IF EL =  4740 THEN _
  325.          GOTO 4745
  326.       IF EL =  5151 AND EC = 62 THEN _
  327.          CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _
  328.          GOTO 5160
  329.       IF EL =  7130 AND EC = 53 THEN _
  330.          GOTO 7260
  331.       IF EL = 20242 AND EC = 62 THEN _
  332.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  333.          GOTO 20247
  334.       IF EL = 20262 THEN _
  335.          A$ = "<Download aborted>" : _
  336.          DOWNLOAD.COMPLETED = FALSE : _
  337.          GOTO 20390
  338.       IF EL = 20452 AND EC = 53 THEN _
  339.          GOTO 20451
  340.       IF EL = 20560 AND EC = 67 THEN _
  341.          GOTO 20451
  342.       IF EL = 20560 AND EC = 70 THEN _
  343.          IF VAL(FREE.SPACE$) > 1999 THEN _
  344.             GOTO 20610 _
  345.          ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  346.               GOTO 5160
  347.       IF EL = 20620 THEN _
  348.          GOTO 20670
  349.       IF EL = 20650 THEN _
  350.          GOTO 20670
  351.       IF EL = 20736 AND EC = 53 THEN _
  352.          GOTO 5160
  353.       IF EL = 20900 AND EC = 75 THEN _
  354.          GOTO 21230
  355.       IF EL = 20900 AND EC = 70 THEN _
  356.          CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  357.          GOTO 21230
  358.       IF EL = 21131 THEN _
  359.          EC = 0 : _
  360.          GOTO 21230
  361.       IF EL = 21480 THEN _
  362.          CALL LOGERROR : _
  363.          IF EC = 57 THEN _
  364.             CALL QTPUT("Error reading file.  Aborting download",1) : _
  365.             DOWNLOAD.COMPLETED = FALSE : _
  366.             GOTO 21230
  367. * REPLACING old line(s) by new
  368. 23000 GET 1,1
  369.       HIGH.MESSAGE.NUMBER = VAL(LEFT$(MESSAGE.RECORD$,8))
  370.       AUTO.ADD.SECURITY   = CVI(MID$(MESSAGE.RECORD$,9,2))
  371.       CALLS.TODATE! = VAL(MID$(MESSAGE.RECORD$,11,10))
  372.       CURRENT.USER.COUNT = VAL(MID$(MESSAGE.RECORD$,57,5))
  373. * ------[ first line different ]------
  374. '     HIGHEST.USER.RECORD = VAL(MID$(MESSAGE.RECORD$,62,5))          ' TF042101
  375.       FIRST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,68,7))
  376.       NEXT.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,75,7))
  377.       HIGHEST.MESSAGE.RECORD = VAL(MID$(MESSAGE.RECORD$,82,7))
  378.       NODES.IN.SYSTEM = VAL(MID$(MESSAGE.RECORD$,127))
  379.       IF LOCAL.USER.MODE AND NOT SYSOP THEN _
  380.          RETURN
  381.       IF NOT SYSOP AND NOT LOCAL.USER THEN _
  382.          RETURN
  383.       IF TEMP.SYSOP THEN _
  384.          RETURN
  385.       IF LAST.MESSAGE.READ < VAL(MID$(MESSAGE.RECORD$,123,4)) THEN _
  386.          LAST.MESSAGE.READ = VAL(MID$(MESSAGE.RECORD$,123,4))
  387.       LAST.MESSAGE.READ = - LAST.MESSAGE.READ * _
  388.                       (LAST.MESSAGE.READ <= HIGH.MESSAGE.NUMBER)
  389.       RETURN
  390. '
  391. ' *****************************************************************************
  392. ' *  UPDATE MESSAGE HEADER RECORD DATA                                        *
  393. ' *****************************************************************************
  394. '
  395.